home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / folds.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-03-20  |  9.2 KB  |  224 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 20 Mar 96
  5. Syntax10b.Scn.Fnt
  6. FoldElems
  7. Syntax10.Scn.Fnt
  8. MODULE Folds;    (* HM 
  9. IMPORT
  10.     Display, Input, Files, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
  11. CONST
  12.     profile = "Folds.Profile";
  13.     CR = 0DX;
  14.     ErrElem = POINTER TO ErrElemDesc;
  15.     ErrElemDesc = RECORD(Texts.ElemDesc)
  16.         err: INTEGER
  17.     END;
  18.     Options = ARRAY 16 OF CHAR;
  19.     w: Texts.Writer;
  20.     errT: Texts.Text;
  21.     compName, errFile: ARRAY 24 OF CHAR;
  22.     globOpt: Options;
  23.     showWarnings: BOOLEAN;
  24. PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);    
  25. END NoNotify;
  26. PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;    
  27. BEGIN RETURN e IS ErrElem
  28. END ErrCheck;
  29. PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);    
  30.     VAR i: INTEGER;
  31. BEGIN i := 0;
  32.     WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
  33.     IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
  34.         REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
  35.     END;
  36.     opt[i] := 0X
  37. END GetOptions;
  38. PROCEDURE MarkedFrame (): TextFrames.Frame;    
  39.     VAR v: Viewers.Viewer;
  40. BEGIN v := Oberon.MarkedViewer();
  41.     IF v.dsc.next IS TextFrames.Frame THEN RETURN v.dsc.next(TextFrames.Frame)
  42.     ELSE RETURN NIL
  43. END MarkedFrame;
  44. PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);    
  45.     VAR x, y, h: INTEGER;
  46. BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
  47.     v := MenuViewers.New(TextFrames.NewMenu("", ""),
  48.  TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  49.     Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
  50.     Viewers.minH := h
  51. END OpenTempViewer;
  52. PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);    
  53.     VAR end, delta: LONGINT;
  54. BEGIN delta := 200;
  55.     LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
  56.         IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
  57.         TextFrames.Show(f, pos - delta); DEC(delta, 20)
  58. END Show;
  59. PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);    
  60.     VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
  61. BEGIN
  62.     WITH E: ErrElem DO
  63.         WITH
  64.              msg: TextFrames.DisplayMsg DO
  65.                 IF ~msg.prepare THEN
  66.                     w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
  67.                     Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 2, w - 2, h, Display.replace)
  68.                 END
  69.         | msg: TextFrames.TrackMsg DO
  70.                 REPEAT
  71.                     Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  72.                 UNTIL keys = {}
  73.         | msg: Texts.CopyMsg DO
  74.                 NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
  75.         ELSE (*ignore it*)
  76.         END
  77. END HandleErr;
  78. PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text);    
  79.     VAR S: Texts.Scanner; pos, delta: LONGINT; err: INTEGER; log: Texts.Text; r: Texts.Reader; ch: CHAR; e: ErrElem;
  80. BEGIN
  81.     log := Oberon.Log; pos := log.len;
  82.     REPEAT DEC(pos); Texts.OpenReader(r, log, pos); Texts.Read(r, ch) UNTIL ch = "c";
  83.     REPEAT INC(pos); Texts.Read(r, ch) UNTIL ch < " ";
  84.     delta := 0; Texts.OpenScanner(S, log, pos+1);
  85.     LOOP S.line := 0;
  86.         REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  87.         IF S.eot OR (S.line # 0) THEN EXIT END;
  88.         pos := S.i;
  89.         REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  90.         IF S.eot OR (S.line # 0) THEN EXIT END;
  91.         IF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
  92.             NEW(e); e.W := 3*TextFrames.mm; e.H := e.W; e.handle := HandleErr; e.err := SHORT(S.i);
  93.             Texts.WriteElem(w, e); Texts.Insert(t, pos + delta, w.buf);
  94.             INC(delta)
  95.         END;
  96.         REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  97. END InsertErrElems;
  98. PROCEDURE DeleteErrElems (t: Texts.Text);    
  99.     VAR r: Texts.Reader; pos: LONGINT;
  100. BEGIN Texts.OpenReader(r, t, 0);
  101.     LOOP Texts.ReadElem(r);
  102.         IF r.elem = NIL THEN EXIT
  103.         ELSIF r.elem IS ErrElem THEN
  104.             pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos)
  105.         END
  106. END DeleteErrElems;
  107. PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;    
  108.     VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
  109. BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
  110.     IF end + 1 = f.text.len THEN INC(end) END; 
  111.         -- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
  112.     Texts.OpenReader(r, f.text, f.org);
  113.     LOOP Texts.ReadElem(r);
  114.         IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
  115.         ELSIF r.elem IS ErrElem THEN RETURN TRUE
  116.         END
  117. END ErrVisible;
  118. PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);    
  119.     VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
  120. BEGIN Texts.OpenScanner(s, errT, 0);
  121.     REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
  122.     WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
  123.     IF ~s.eot THEN Texts.Read(s, ch); n := 0;
  124.         WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
  125.         msg[n] := 0X
  126. END GetErrMsg;
  127. PROCEDURE SetProfile*;    
  128.     VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
  129. BEGIN
  130.     compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
  131.     f := Files.Old(profile);
  132.     IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
  133.         WHILE ~ s.eot DO
  134.             IF s.class = Texts.Name THEN
  135.                 IF s.s = "compiler" THEN
  136.                     Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
  137.                     GetOptions(s, globOpt)
  138.                 ELSIF s.s = "errorFile" THEN
  139.                     Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
  140.                 ELSIF s.s = "showWarnings" THEN
  141.                     Texts.Scan(s); Texts.Scan(s);
  142.                     showWarnings := s.s = "yes"
  143.                 END
  144.             END;
  145.             Texts.Scan(s)
  146.         END
  147.     END;
  148.     errT := TextFrames.Text(errFile)
  149. END SetProfile;
  150. PROCEDURE Compile*;    
  151.     VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
  152.         beg, end, time: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
  153.         ready: BOOLEAN; opt: Options;
  154. BEGIN
  155.     par := Oberon.Par;
  156.     Texts.OpenScanner(s, par.text, par.pos); 
  157.     REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
  158.         IF par.vwr.dsc = par.frame THEN
  159.             f := par.frame.next(TextFrames.Frame);
  160.             Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
  161.             Oberon.FadeCursor(Oberon.Pointer);
  162.             t := f.text; opt := globOpt; ready := TRUE
  163.         ELSE
  164.             IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
  165.             ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
  166.                 f := MarkedFrame(); IF f # NIL THEN t := f.text END;
  167.                 ready := TRUE
  168.             ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
  169.                 Oberon.GetSelection(t, beg, end, time);
  170.                 IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s); 
  171.                     IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
  172.                 END
  173.             END;
  174.             GetOptions(s, opt)
  175.         END;
  176.         IF t # NIL THEN
  177.             DeleteErrElems(t);
  178.             oldNotify := t.notify; t.notify := NoNotify;
  179.             FoldElems.ExpandAll(t, 0, TRUE);
  180.             IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
  181.             par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
  182.             Texts.Append(par.text, w.buf); par.pos := 0;
  183.             Oberon.Call(compName, par, FALSE, res);
  184.             IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t) END;
  185.             FoldElems.CollapseAll(t, {FoldElems.tempLeft});
  186.             IF f = NIL THEN
  187.                 Viewers.Close(v)
  188.             ELSE
  189.                 t.notify := oldNotify;
  190.                 IF ErrVisible(f) THEN t.notify(t, Texts.replace, 0, t.len) END
  191.             END
  192.         END
  193.     UNTIL (t = NIL) OR ready
  194. END Compile;
  195. PROCEDURE ShowError*;    
  196.     VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
  197. BEGIN
  198.     IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next;
  199.     ELSE F := Oberon.MarkedViewer();
  200.         IF (F .dsc # NIL) & (F.dsc.next # NIL) THEN F := F.dsc.next END ;
  201.     END ;
  202.     WITH F: TextFrames.Frame DO
  203.         IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
  204.         FoldElems.FindElem(F.text, pos, ErrCheck, e);        (*<<RD*)
  205.         FoldElems.FindElem(F.text, pos, ErrCheck, e, pos);
  206.         IF e # NIL THEN
  207.             pos:=Texts.ElemPos(e);        (*<<RD*)
  208.             Show(F, pos);
  209.             TextFrames.SetCaret(F, pos + 1);
  210.             GetErrMsg(e(ErrElem).err, msg);
  211.             Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  212.         END
  213.     ELSE
  214. END ShowError;
  215. PROCEDURE Restore*;    
  216.     VAR f: TextFrames.Frame;
  217. BEGIN
  218.     f := MarkedFrame();
  219.     IF f # NIL THEN FoldElems.CollapseAll(f.text, {FoldElems.findLeft}) END
  220. END Restore;
  221. BEGIN
  222.     Texts.OpenWriter(w); SetProfile
  223. END Folds.
  224.